home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / archives.swg / 0021_Arithmetic compression.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  3.6 KB  |  133 lines
  1. {
  2. Hello Thomas,
  3.  
  4. On 26.06.94 you wrote in area PASCAL to subject "Arithmetic compression":
  5. TW> But where can we get a discription of this compression method ??
  6.   Michael  Barnsley, Lyman Hurd, "Fractal Image Compression", AK Peters,
  7.   1993
  8.   Mark Nelson, "The Data Compression Book", M&T Books, 1991
  9.   Ian  Witten,  Radford  Neal,  John Cleary, "Arithmetic Coding for Data
  10.   Compression", CACM, Vol. 30, No.6, 1987
  11.  
  12.   Below  is a small source from the 1st book, translated into Pascal and
  13.   adopted  to  work  on  the uppercase alphabet to demonstrate the basic
  14.   principles.
  15.   For  a  simple  explanation, the program uses the letters of the input
  16.   string  to "drive" the starting point through the real interval 0.0 ..
  17.   1.0
  18.   By  this process, every possible input string stops at a unique point,
  19.   that  is:  a  point  (better: a small interval section) represents the
  20.   whole  string.  To  _decode_  it, you have to reverse the process: you
  21.   start  at  the  given  end point and apply the reverse transformation,
  22.   noting  which intervals you are touching at your voyage throughout the
  23.   computation.
  24.   Due  to the restricted arithmetic resolution of any computer language,
  25.   the  max.  length of a string will be restricted, too (try it out with
  26.   TYPE   REAL=EXTENDED,  for  example);  this  happens  when  the  value
  27.   "underflows" the computers precision. }
  28.  
  29. {$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P+,Q-,R+,S+,T-,V+,X+,Y+}
  30. {$M 16384,0,655360}
  31. PROGRAM arithmeticCompression;
  32. USES CRT;
  33. CONST charSet:STRING='ABCDEFGHIJKLMNOPQRSTUVWXYZ ';
  34.       size=27; {=Length(charSet)}
  35.       p:ARRAY[1..size] OF REAL=  (* found empirically *)
  36.        (
  37.         6.1858296469E-02,
  38.         1.1055412402E-02,
  39.         2.6991022453E-02,
  40.         2.6030374520E-02,
  41.         9.2418577127E-02,
  42.         2.1864028512E-02,
  43.         1.4977615842E-02,
  44.         2.8410764564E-02,
  45.         5.5247871050E-02,
  46.         1.3985123226E-03,
  47.         3.8001321554E-03,
  48.         3.2593032914E-02,
  49.         2.1919756707E-02,
  50.         5.2434924064E-02,
  51.         5.7837905257E-02,
  52.         2.0364674693E-02,
  53.         1.0031075103E-03,
  54.         4.9730779744E-02,
  55.         4.8056280170E-02,
  56.         7.2072478498E-02,
  57.         2.0948493879E-02,
  58.         8.2477728625E-03,
  59.         1.0299101184E-02,
  60.         4.7873173243E-03,
  61.         1.3613601926E-02,
  62.         2.7067980437E-03,
  63.         2.3933136781E-01
  64.        );
  65. VAR   psum:ARRAY[1..size] OF REAL;
  66.  
  67.  FUNCTION Encode(CONST s:STRING):REAL;
  68.  VAR i,po:INTEGER;
  69.      offset,len:REAL;
  70.  BEGIN
  71.   offset:=0.0;
  72.   len:=1.0;
  73.   FOR i:=1 TO Length(s) DO
  74.    BEGIN
  75.     po:=POS(s[i],charSet);
  76.     IF po<>0
  77.      THEN BEGIN
  78.            offset:=offset+len*psum[po];
  79.            len:=len*p[po]
  80.           END
  81.      ELSE BEGIN
  82.            WRITELN('only input chars ',charSet,' allowed!');
  83.            Halt(1)
  84.           END;
  85.    END;
  86.   Encode:=offset+len/2;
  87.  END;
  88.  
  89.  FUNCTION Decode(x:REAL; n:BYTE):STRING;
  90.  VAR i,j:INTEGER;
  91.      s:STRING;
  92.  BEGIN
  93.   IF (x<0.0) OR (x>1.0)
  94.    THEN BEGIN
  95.          WRITELN('must lie in the range [0..1]');
  96.          Halt(1)
  97.         END;
  98.   FOR i:=1 TO n DO
  99.    BEGIN
  100.     j:=size;
  101.     WHILE x<psum[j] DO DEC(j);
  102.     s[i]:=charSet[j];
  103.     x:=x-psum[j];
  104.     x:=x/p[j];
  105.    END;
  106.   s[0]:=CHR(n);
  107.   Decode:=s
  108.  END;
  109.  
  110. CONST
  111.      inp='ARITHMETIC';
  112. VAR
  113.     r:REAL;
  114.     i,j:INTEGER;
  115.  
  116. BEGIN
  117.  
  118.  FOR i:=1 TO size DO
  119.   BEGIN
  120.    psum[i]:=0.0;
  121.    FOR j:=1 TO i-1 DO
  122.     psum[i]:=psum[i]+p[j];
  123.   END;
  124.  
  125.  ClrScr;
  126.  WRITELN('encoding string    : ',inp);
  127.  r:=Encode(inp);
  128.  WRITELN('string is encoded by ',r);
  129.  WRITELN('decoding of r gives: ',Decode(r,Length(inp)));
  130.  
  131. END.
  132.  
  133.